home *** CD-ROM | disk | FTP | other *** search
- unit Arrtest6;
-
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs, StdCtrls, VBXCtrl, Gauge, ExtCtrls;
-
- type
- TProgressDlg = class(TForm)
- BtnAbort: TButton;
- Gauge: TBiGauge;
- Panel1: TPanel;
- LblAction: TLabel;
- LblFilename: TLabel;
- procedure BtnAbortClick(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- private
- faborted : Boolean;
- { Private-Deklarationen }
- public
- Function ReportProgressOnLoad( pos, max: LongInt;
- Var retain: Boolean ): Boolean;
- Function ReportProgressOnStore( pos, max: LongInt;
- Var retain: Boolean ): Boolean;
- end;
-
- var
- ProgressDlg: TProgressDlg;
-
- implementation
-
- {$R *.DFM}
-
- Function TProgressDlg.ReportProgressOnLoad( pos, max: LongInt;
- Var retain: Boolean ): Boolean;
- Begin
- Application.ProcessMessages;
- If faborted Then Begin
- FormStyle := fsNormal;
- retain :=
- MessageDlg('Do you want to retain the data already read?',
- mtConfirmation, [mbYes, mbNo],0 ) = mrYes
- End
- Else
- Gauge.Value := (pos*100) div max;
- Result := not faborted;
- End; { TProgressDlg.ReportProgressOnLoad }
-
- Function TProgressDlg.ReportProgressOnStore( pos, max: LongInt;
- Var retain: Boolean ): Boolean;
- Begin
- Application.ProcessMessages;
- If faborted Then Begin
- FormStyle := fsNormal;
- retain :=
- MessageDlg('Do you want to retain the incomplete file?',
- mtConfirmation, [mbYes, mbNo],0 ) = mrYes
- End
- Else
- Gauge.Value := (pos*100) div max;
- Result := not faborted;
- End; { TProgressDlg.ReportProgressOnStore }
-
- procedure TProgressDlg.BtnAbortClick(Sender: TObject);
- begin
- faborted := true;
- end;
-
- procedure TProgressDlg.FormClose(Sender: TObject;
- var Action: TCloseAction);
- begin
- Action := caFree;
- end;
-
- end.
-